home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / vsc92nov.zip / Number.c < prev    next >
C/C++ Source or Header  |  1992-11-02  |  2KB  |  104 lines
  1. /*
  2.  * Number.c -- Implementation of generic Scheme numbers
  3.  *
  4.  * (C) m.b (Matthias Blume), Mon May 11 13:02:00 MET DST 1992, HUB/Ger
  5.  *         Humboldt-University of Berlin, Germany
  6.  */
  7.  
  8. # ident "@(#)Number.c    (C) M.Blume, Humboldt-Uni Berlin, 1.2"
  9.  
  10. # include "storext.h"
  11. # include "Number.h"
  12. # include "Fixnum.h"
  13. # include "identifier.h"
  14. # include "Cont.h"
  15. # include "type.h"
  16. # include "except.h"
  17.  
  18. static
  19. void apply_to_subs (void *vnumber, applied_proc proc, void *cd)
  20. {
  21.   ScmNumber *number = vnumber;
  22.  
  23.   (* proc) ((void *)&number->value, cd);
  24. }
  25.  
  26. static
  27. void display (void *vnumber, putc_proc pp, void *cd)
  28. {
  29.   display_object (((ScmNumber *) vnumber)->value, pp, cd);
  30. }
  31.  
  32. static
  33. void write_this (void *vnumber, putc_proc pp, void *cd)
  34. {
  35.   write_object (((ScmNumber *) vnumber)->value, pp, cd);
  36. }
  37.  
  38. static
  39. int equal (void *vself, void *vother)
  40. {
  41.   if (ScmTypeOf (vother) != ScmTypeOf (vself))
  42.     return 0;
  43.   else
  44.     return equal_object (
  45.         ((ScmNumber *) vself)->value,
  46.         ((ScmNumber *) vother)->value);
  47. }
  48.  
  49. static
  50. struct scheme_od_extension ext = {
  51.   display, write_this,
  52.   equal, equal,
  53. };
  54.  
  55. OD_VECTOR (ScmExactNumber_od_vector,
  56.   sizeof (ScmNumber),
  57.   NULL,
  58.   apply_to_subs,
  59.   EXACT_NUMBER_IDENTIFIER,
  60.   NULL, NULL, NULL,
  61.   NULL, NULL, NULL,
  62.   &ext
  63. );
  64.  
  65. OD_VECTOR (ScmInexactNumber_od_vector,
  66.   sizeof (ScmNumber),
  67.   NULL,
  68.   apply_to_subs,
  69.   INEXACT_NUMBER_IDENTIFIER,
  70.   NULL, NULL, NULL,
  71.   NULL, NULL, NULL,
  72.   &ext
  73. );
  74.  
  75. long ScmNumberToInt (void *vnumber)
  76. {
  77.  
  78.   ScmNumber *number;
  79.   long res;
  80.   int valid;
  81.  
  82.   if (ScmTypeOf (vnumber) != ScmType (ExactNumber))
  83.     error ("ScmNumberToInt requires exact numbers: %w", vnumber);
  84.   number = vnumber;
  85.   res = ScmNRT_get_long (number->value, &valid);
  86.   if (valid)
  87.     return res;
  88.   else
  89.     error ("bad argument to ScmNumberToInt: %w", vnumber);
  90.   /*NOTREACHED*/
  91. }
  92.  
  93. ScmNumber *ScmIntToExactNumber (long x)
  94. {
  95.   ScmNumber *res;
  96.   void *fix;
  97.  
  98.   fix = ScmLong2Fixnum (x);
  99.   ScmPush (fix);
  100.   res = new (ScmType (ExactNumber));
  101.   res->value = ScmPop ();
  102.   return res;
  103. }
  104.